C***** F4PAG.F4 *********
C**** SHFTQ, SORT2, NORH, MINMAX, PFIBX, PFIB, RLOOP, BLTEM
C**** GETPTS, SETN, EXTEN, DBAR, ADRST,QRN, SORT, SHIFT,SHFT1    
C**** SHFT0,PSHFT,STAFF, RIGHT, RESTS, EXCHG, EXCH, INMUS, RCURVE
C**** SHRNK, EXPND, SLRV,CLEFN, MMNN, CODEN, ZERO, BARFAC
	SUBROUTINE SHFTQ(R)
	COMMON /JN/JN,JX /XRN/MM(1) /Q/Q(1)
	DO 1 K=1,JX
	L=MM(K)
1	Q(L)=Q(L)+R
C SHIFTS  ALL POSITION PARAMS.
	END

	SUBROUTINE SORT2(RPOS,M)
	DIMENSION RPOS(2,200)
	L=2
3	J=-1
	RX=RPOS(1,L-1)
	DO 2 K=L,M
	IF(RPOS(1,K).GE.RX)GO TO 2
	RX=RPOS(1,K)
	J=K
2	CONTINUE
	IF(J.LT.0)GO TO 4
	K=L-1
C  EXCHANGE THE POSITIONS IN THE LIST
	RX=RPOS(1,K)
	RPOS(1,K)=RPOS(1,J)
	RPOS(1,J)=RX
	RX=RPOS(2,K)
	RPOS(2,K)=RPOS(2,J)
	RPOS(2,J)=RX
4	L=L+1
	IF(L.LE.M)GO TO 3
	END

	FUNCTION NORH(KK,K)
	COMMON /XRN/R(500),NN(1)
C FIND VALUE IN NN ARRAY IN DO LOOP.
	KK=NN(K)
	NORH=0
	IF(KK.LE.0)GO TO 1
C NORH=-1 IF KK≤0, >18, NOT 1,2,4,17.
	IF(KK.LE.2.OR.KK.EQ.4)RETURN
	IF(KK.EQ.17.OR.KK.EQ.18)RETURN
1	NORH=-1
	END

	SUBROUTINE FNDEND(R)
	COMMON /XRN/RN(500),NN(1) /ENDL/ENDLN
	K=1
1	N=NN(K)
	IF(N.LE.0)GO TO 2
	IF(N.LE.3.OR.N.EQ.17.OR.N.EQ.18)GO TO 3
2	K=K+1
	GO TO 1
C ASSUMES IT WILL ALWAYS END PROPERLY
3	R=ENDLN+2.0-RN(K)
	END

	SUBROUTINE MINMAX(JRN)
	COMMON /MNX/MIN,MAX,JT
	DIMENSION JRN(1)
C GET FIRST VALUE OF CURRENT JRN ARRAY
	MIN=JRN(1)
	MAX=MIN
	DO 107 K=1,JT
	NN=JRN(K)
	IF(NN.LT.MIN)MIN=NN
107	IF(NN.GT.MAX)MAX=NN
	END

	FUNCTION PFIBX(A)
	DATA FIB/0.618/, RFIB/-.382/
	PFIBX=14.
	IF(A.EQ.1.)RETURN
	Z=FIB
	X=ALOG(A)/0.6931472
	RH=ABS(X)
	IF(X.LE.0)Z=RFIB
	L=RH
	IF(L.EQ.0)GO TO 4
	DO 3 K=1,L
3	PFIBX=PFIBX+PFIBX*Z
4	RH=RH-L
	IF(RH.EQ.0)RETURN
	PFIBX=PFIBX+PFIBX*Z*RH
C SEND BACK THE RESULT
	END

	FUNCTION PFIB(P)
C   PSEUDO-FIBONACCI RHYTHM SPACER
	PFIB=(P+(.125-P)*(.8+.02*P))*50
	END

	SUBROUTINE RLOOP(A,B,K)
	DIMENSION A(1),B(1)
	DO 1 J=1,K
1	A(J)=B(J)
	END

C  BLTEM BLTS (WHEN IN FAIL) ARRAYS KPN AND Q INTO KWDS AND RN
	SUBROUTINE BLTEM
	COMMON /XRN/RN(1) /PTR/KWDS(1) /PX/KPN(1) /Q/Q(1)
	COMMON /POSI/STFF(8),JJ2,JPQ /RCLF/KK,CLEF,KW,ITEM
CC	DO 1511 K=1,ITEM+1
CC1511	KWDS(K)=KPN(K)
CC	DO 1611 K=1,JPQ
CC1611	RN(K)=Q(K)
	CALL RLOOP(KWDS,KPN,ITEM+1)
	CALL RLOOP(RN,Q,JPQ)
	END
 
 	SUBROUTINE GETPTS(NX,RN,KWDS)
C  'NX' DOES NOT SEEM TO BE USED
	DIMENSION RN(1),KWDS(1)
	COMMON/KNR/N(1) /NNP/NP(1) /LLL/LLL
	COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS
	COMMON/POSI/STFF(8),JJ2,JPQ /KJY/ K,J
	EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3))

		J=0
		K=0
CC	JX=JJ2
C GET THE STAFF NUM. (NEG= ALL IN THIS PROG.)
	DO 1 M=1,LLL
	L=KWDS(M)
	IF(R2.LT.0)GO TO 9
	IF(RN(L+1).NE.R2)GO TO 1
C NEG R2=ALL STAVES   CHECK NOW FOR CORRECT STAFF

9	X=RN(L+3)
	IF(X.LT.R4.OR.X.GT.R5)GO TO 2
C NOW P3 IS IN LIMITS
	IF(JJ2.LE.0)JJ2=M
	J=J+1
CC	MOVEI	0,(L)
	K=K+1
	NP(K)=L
C  NP LIST POINTS TO START OF EACH ITEM TO MOVE
	N(J)=L+3
C  N LIST POINTS TO PARAM TO BE MOVED
C  NP IS FOR USE IN JUSTIFY ROUTINE
2	RY=RN(L+1)
C  RY IS CODE NUMBER OF ITEM
	IF(RY.EQ.2.)GO TO 99
C JUMP IF REST
	IF(RY.LT.4)GO TO 1
	RZ=RN(L)
C RZ IS WDCNT.   CODE 4 IS SOMETIMES =44
	IF(RY.NE.44.)GO TO 98
	IF(RZ.LE.2.)GO TO 1
	GO TO 5
C IF(RZ.LE.2)THEN IT'S A CODE 44 BAR LINE.
C FOUND A LINE
98	IF(RY.GT.7.)GO TO 1
C  TWO-ENDED ITEM?
	GO TO (4,5,6,7),IFIX(RY)-3
7	IF(RZ.GT.4.)GO TO 1
C  FOR TRILL??
4	IF(RZ.GT.3.)GO TO 5
C CHECK WDCNT
	GO TO 1
99	RZ=RN(L)
C FOR 'CENTERED' RESTS
	GO TO 8
6	IF(RZ.LT.8.)GO TO 8
	IF(RN(L+7).LT.0)GO TO 8
C  THESE ARE FOR VARIOUS BEAM PARAMS.
	IF(RN(L+10).EQ.0)GO TO 8
C IGNORE P8 IF IT IS 0 OR -
	X=RN(L+8)
	IF(X.LE.0)GO TO 8
	IF(X.LT.R4)GO TO 8
	IF(X.GT.R5)GO TO 8
C NOW P8 IS IN LIMITS
	CALL SETN(L+8,M)
C  FIND LOWEST ITEM NUMBER NEEDED
C SAVE POINTER TO P8 FOR MOVING.
8	IF(RZ.LT.7.)GO TO 5
C JUMP IF WDCNT IS .LT. 7
	IF(RN(L+9).LE.0)GO TO 5
	IF(RY.EQ.2.)GO TO 97  
C NEW CENTERED RESTS  HAS POSITION IN P9
	IF(RN(L+8).NE.0)GO TO 97
	IF(RN(L+7).GE.0)GO TO 5
97	X=RN(L+9)
	IF(X.LT.R4)GO TO 5
	IF(X.GT.R5)GO TO 5
C  NOW P9 IS IN LIMITS
	CALL SETN(L+9,M)
5	IF(RY.EQ.2.)GO TO 1  
	X=RN(L+6)
	IF(X.LT.R4)GO TO 1
	IF(X.GT.R5)GO TO 1
C  NOW P6 IS IN LIMITS
	CALL SETN(L+6,M)
1	CONTINUE
	END

	SUBROUTINE SETN(L,M)
	COMMON/POSI/STFF(8),JJ2 /KJY/ K,J /KNR/N(1)
	IF(JJ2.GT.M)JJ2=M
C  FIND LOWEST ITEM NUMBER NEEDED
	J=J+1
	N(J)=L
	END
	SUBROUTINE MOVIT(RN,NP,R4,R5,R8,R9)
	DIMENSION  NP(1),RN(1)
	COMMON  /KJY/ KD,J
	RDIS=(R9-R8)/(R5-R4)
	DO 1 K=1,J
	L=NP(K)
	RA=RN(L)
	IF(RA.LT.R4)GO TO 1
	IF(RA.GT.R5)GO TO 1
C  NOW IN BOUNDS
	IF(R9.NE.0)RA=(RA-R4)*RDIS
	RN(L)=R8+RA
1	CONTINUE
	END

	FUNCTION EXTEN(X)
	EXTEN=AMOD(X,1.)*10.
	END

	SUBROUTINE DBAR(K,ITEM,J)
	COMMON /XRN/RN(1) /RR/RR /PTR/KWDS(1)

	RR=RN(J+3)
C  SAVE POSITION OF ITEM.  ALSO USED IN ADRST ROUTINE.
	DO 82 KY=K+1,ITEM
	KZ=KWDS(KY)
	IF(RN(KZ+1).NE.4.)GO TO 82
	IF(RN(KZ).GT.3.)GO TO 82
C  CHECK THE WDCNT
	IF(ABS(RR-RN(KZ+3)).GT..5)GO TO 82	
C  AVOIDS DUPLICATE BARS.
	RN(KZ+2)=99.
	RN(KZ+1)=0
82	CONTINUE
	END


	SUBROUTINE ADRST(JWDS,RA)
	COMMON /XXX/LK,LP,JY /Q/Q(1) /RR/RR  /LLL/LLL 
	DIMENSION JWDS(1)

	Q(LK)=6.
	Q(LK+1)=2.
C SET UP THE REST
	Q(LK+2)=0
	Q(LK+3)=RR-1.
C GET POSITION FROM ROUTINE ABOVE
	Q(LK+4)=0
	Q(LK+5)=0
	Q(LK+6)=0
	Q(LK+7)=6.
	Q(LK+8)=-1.
C NEXT ADDS A BAR LINE
	LK=LK+9
	JWDS(LLL+1)=LK
CHECK THIS ******************
	Q(LK)=2.
	Q(LK+1)=4.
	Q(LK+2)=0
	Q(LK+3)=RR
	Q(LK+4)=RA
	LK=LK+5
	JWDS(LLL+2)=LK
	LLL=LLL+2
	END

	SUBROUTINE QRN(J,JWDS,K)
	DIMENSION JWDS(1)
	COMMON RS,JA,REST,J2,RQ(2),R5
	COMMON /XRN/RN(1) /PTR/KWDS(1) /XXX/LK /Q/Q(1) /LLL/LLL
	COMMON /RCLF/RCLF,CLEF /SF/KL
	JA=KWDS(K+1)
	LX=LK
	DO 7 KY=J,JA-1
	Q(LK)=RN(KY)
7	LK=LK+1
	IF(KL.EQ.0)GO TO 5
C PUT A 1.0 AS RHYTHM FOR REST OR NOTE
	LK=LK+KL-1
	Q(LK)=1.
C PUT IT IN PARAM 7 OR 9
CC5	LK=LK+1
5	IF(R5.LT.0)GO TO 2
	Q(LX+5)=R5
	WDC=3.
3	LK=LK+WDC-Q(LX)
C  UPDATE THE MAIN COUNTER
	Q(LX)=WDC
	GO TO 1
2	IF(RCLF.NE.17.)GO TO 1
	Q(LX+6)=CLEF
C  GET THE CLEF NUM.
	WDC=4.
	GO TO 3
1	JWDS(LLL+1)=LK
	LLL=LLL+1
	END

	SUBROUTINE SORT(JWDS)
	DIMENSION JWDS(1)
	COMMON /LLL/LLL /Q/Q(1) /XRN/RN(1) /PTR/KWDS(1)
	I=1
	DO 243 K=1,LLL-1
	LB=JWDS(K)+1
	IF(Q(LB).NE.16.)GO TO 243
	IF(Q(LB-1).LT.8.)GO TO 243
	JL=JWDS(K-1)
244	Q(LB+2)=Q(JL+3)
243    CONTINUE

C PUTS CONTINUATION OF TEXT IMMEDIATELY AFTER PREV. POS.
C   FOR SPACING PROBLEMS BELOW.
	M=2
	J=1
24	RA=100000.
C  POSITION
	DO 21 K=1,LLL-1
	JL=JWDS(K)+3
	R=Q(JL)
	IF(R.EQ.100000.)GO TO 21
241	IF(ABS(R-RA).GT..1)GO TO 240
	Q(JL)=RA
	GO TO 21
CC PUT IN HERE MULTI-VOICE TRAP SOMEDAY
240	IF(R.GT.RA)GO TO 21
C  LINES THEM UP
	RA=R
CC	I=JL-3
	I=K
21	CONTINUE
	IF(RA.EQ.100000.)RETURN
C  JUMP IF ALL SORTED
242	JL=JWDS(I)
	LA=JL
	N=Q(JL)+3
	KWDS(M)=KWDS(M-1)+N
	M=M+1
	DO 22 K=J,J+N-1
	RN(K)=Q(JL)
22	JL=JL+1
	J=J+N
	Q(LA+3)=100000.
	GO TO 24
	END

	SUBROUTINE SHIFT
	COMMON /PX/KPN(1) /Q/Q(1) /LLL/LLL
	K=1
	L=1
	LK=0
221	NN=KPN(K)
	IF(Q(NN+1).LT.0)GO TO 321
	M=KPN(K+1)
2	Q(L)=Q(NN)
	NN=NN+1
	IF(NN.GE.M)GO TO 1
	L=L+1
	GO TO 2
1	LK=LK+1
	L=L+1
	KPN(LK+1)=L
C SET NEXT POINTER
321	K=K+1
	IF(K.LT.LLL)GO TO 221
	LLL=LK
	END

	SUBROUTINE SHFT1(KQ)
	COMMON /LLL/L /Q/Q(1) /XRN/RN(1) /PX/KPN(1) /IPG/IPG
	L=1
	K=1
220	JJ=Q(K)+3
	KPN(L)=K
C NEW POINTER
	IF(Q(K+1).NE.2.OR.Q(K).LT.6)GO TO 1
	JK=JJ+K
	IF(Q(JK+1).NE.10.OR.Q(JK).LT.6)GO TO 1
	IF(IPG.EQ.0)GO TO 1
C do next only when extracting parts(IPG.NE.0)
	M=0
	KK=Q(JK)+2
	DO 2 N=K,K+KK+JK-1
	M=M+1
2	RN(M)=Q(N)
	M=JK-K
	J=KK-JK
	KA=J+K
	NA=K
	B=RN(M+3)
C  SAVE POS. (P3)
	DO 3 N=K,KA-1
	Q(N)=RN(M)
3	M=M+1
	JK=K+J
	M=1
	A=RN(4)
C POS OF THIS ITEM
	Q(NA+3)=A
	RN(4)=B
	DO 4 N=JK,KK-1
	Q(N)=RN(M)
4	M=M+1
C  ALL THIS TO FIND NUM AFTER REST.
C GO BACK TO GET RIGHT PNTRS NOW.
	GO TO 220
1	K=K+JJ
	IF(K.GE.KQ)GO TO 5
	L=L+1
	GO TO 220
5	L=L+1
	KPN(L)=K
	END

	SUBROUTINE SHFT0(KQ)
	COMMON /LLL/L /XRN/RN(1) /Q/Q(1) /XXX/LK /PTR/KWDS(1)
	DO 32 K=1,KWDS(L)-1
	KQ=KQ+1
32	Q(KQ)=RN(K)
	L=1
	LK=1
	END

	SUBROUTINE PSHFT(I)
	COMMON /SF/KL /PX/KPN(1) /Q/Q(1) /XRN/RN(1)
	M=KPN(I+1)
	DO 31 NA=1,M
	RN(KL)=Q(NA)
31	KL=KL+1
	END

	SUBROUTINE STAFF(P0,P1, P3,P4,P5,P6,P7,P8,P9,P10,P11,P12)
	COMMON/XRN/RN(1) /PTR/KWDS(1) /SF/KL,RT,KP
	KWDS(KP)=KL
	KP=KP+1
	RN(KL)=P0
	RN(KL+1)=P1
	RN(KL+2)=RT
	RN(KL+3)=P3
	RN(KL+4)=P4
	RN(KL+5)=P5
	IF(P0.LT.4.)GO TO 1
	RN(KL+6)=P6
	RN(KL+7)=P7
	RN(KL+8)=P8
	RN(KL+9)=P9
	RN(KL+10)=P10
	RN(KL+11)=P11
	RN(KL+12)=P12
1	KL=KL+3+P0
	END

	FUNCTION RIGHT(NA,J,JK)
	COMMON /PX/KPN(1) /Q/Q(1) /LLL/LLL,LL,I
	K=NA+J
	N6=NJ
	IF(K.GT.0)GO TO 4
	RIGHT=Q(4)
	RETURN
4	RX=Q(JK+3)
	R=Q(JK+2)
	JX=1
	IF(J.GT.0)JX=I  
C FORWARD LOOP
1	R8=CODEN(KPN,K,Q,LA)
	IF(R8.EQ.4)GO TO 2
 	IF(Q(LA+2).NE.R)GO TO 3
	IF(R8.EQ.18..OR.R8.EQ.17.)GO TO 2
C JUMP ON KEY SIG OR METER
3	IF(K.EQ.JX)GO TO 5
	K=K+J
	GO TO 1
5	IF(J.LE.0)RIGHT=RX
	RETURN  
C SKIP NEXT IF GOING FORWARD IN LOOP (LOOKING TO RIGHT)
C USE ITS OWN POS.-2 IF NOTHING FOUND TO LEFT
C C NOW FOUND ITEM TO LEFT OR RT ON THIS STAFF.
2	RIGHT=Q(LA+3)
	END

	SUBROUTINE RESTS
	COMMON /PX/KPN(1) /Q/Q(1) /LLL/LLL
	XLFT=0
	SIG=-99
	REST=0
	K=1
50	JL=KPN(K)
	R=Q(JL+1)
	IF(XLFT.NE.0)GO TO 5
	IF(R.LE.4)XLFT=Q(JL+3)
	GO TO 3 
5	IF(R.NE.17)GO TO 3
	IF(Q(JL+5).EQ.SIG)GO TO 60
	SIG=Q(JL+5)
3	IF(R.NE.2)GO TO 231
	IF(Q(JL).GE.6)GO TO 7
	GO TO 231 
7	IF(Q(JL+8).LE.-4)GO TO 231
	IF(Q(JL+7).LE.0)GO TO 231
C (IGNORE NON-RHYTH.)
C CATCH BAR REPEAT SIGN
	IF(Q(JL+8).EQ.0)GO TO 231
C (WHOLE REST OVER CUE NOTES)
	IF(REST.NE.0)GO TO 6
	JR=JL+6
C  POINTER TO REST NUM.
	R=Q(JR+1)
	IF(R.LT.5)R=5
	Q(JR+1)=R*.6
C  REDUCE SIZE OF REST'S TIME SO IT WILL TAKE LESS SPACE.
6	REST=REST+1.
	Q(JR+2)=REST
	Q(JR-2)=-2.
C (LOWER THE REST'S POS.)
	JL=K+2
	IF(JL.GE.LLL)RETURN
	LB=KPN(JL)
	IF(Q(LB+1).NE.2)GO TO 233
C NEXT IS TO COMBINE MEASURES OF REST
	IF(Q(LB).LT.6)GO TO 233
C  SKIP NON-WHOLE RESTS
	N=KPN(JL-1)
	IF(Q(N+1).NE.4.)GO TO 233
C  IS REST FOLLOWED BY A BAR?	OR RHRSL NUM?(COULD BE A PROB. HERE!!!)
C SO IT WON'T BE FOUND NEXT TIME AROUND.
	Q(LB+1)=-1.
C   CHANGE CODE #
	Q(N+1)=-1.
	K=JL
	GO TO 6
60	Q(JL+1)=-1.
	GO TO 231
233	REST=0
231	K=K+1
	IF(K.LT.LLL)GO TO 50
	END

	SUBROUTINE EXCHG(M,N)
	DIMENSION M(2),N(2)
	J=M(1)
	M(1)=M(2)
	M(2)=J
	J=N(1)
	N(1)=N(2)
	N(2)=J
	END

	SUBROUTINE EXCH(J,K)
	L=J
	J=K
	K=L
	END	

	SUBROUTINE INMUS(NAME,EXT,RN,KWDS,JSTFAC)
	DIMENSION RN(1),KWDS(1),JSTFAC(1)
	CALL GETEXT(NAME,EXT)
	CALL EXTIN(JSTFAC,20)
C READ ONLY 20 WDS IN PAGE ONLY****** NOT [=128]  
	JJ=JSTFAC(19)
C JSTFAC(19) = THE WD CNT.
C ********** CHANGE JSTFAC ARRAY FOR PDP11 ***************
	CALL EXTIN(RN,JJ)
C	MOVE @15	;@R		;IF(R(1).NE.INTEGER 1)GO TO I3
C	CAIE 1		;OLD FORMAT ?    ***** ASSUMES NEW FORMAT (NO KWDS ARRAY)
C	JRST I3		;NO
C	USETI 12,2	;YES, READ 2ND RECORD AGAIN   (12 =CH)
C	JSA 16,EXTIN  	;CALL EXTIN(RS,128)
C	JUMP @12	;JUMP @KW
C	JUMP =17(11)	;JUMP NWDS    	;CALL EXTIN(K,J)
C	JRST I1		;GO BACK AND GET R ARRAY
3	N=1 
	L=1
	KWDS(1)=1
4	N=N+RN(N)+3
C   HERE'S THE LOOP 
C GET WD CNT -2
	L=L+1
C  UPDATE THE COUNTER OF THE POINTER LIST
	KWDS(L)=N
	IF(N.LT.JJ)GO TO 4
	END

	FUNCTION RCURVE(R)
	DIMENSION R(1)
C R(1) IS R3   R(4) IS R6, ETC.
	X=R(4)-R(1)
	RCURVE=R(6)+1.
	IF(RCURVE.LT.0)X=X+RCURVE+RCURVE
	X=X/25.
C R8=-2=BETWEEN NOTES, =-3=1ST NOTE IS DOTTED.
	RCURVE=X+2.+ABS(R(3)-R(2))/10.
	IF(R(5).LT.0)RCURVE=-RCURVE
C IF(R7 WAS .LT.0)KEEP IT NEGATIVE.
	END

	SUBROUTINE SHRNK(K,IT)
	COMMON R2,JA,REST,J2,R3,R4,R5,R6,R7,R8,R9
	COMMON /PX/KPN(1) /Q/Q(1) /LLL/LLL,LL,I
	L10=IT-1
	L11=KPN(IT+1)
C END OF Q DATA
C	X=Q(L+3)
	K2=K
	K12=K2
	K3=KPN(K2)
	K6=K3
C	A13=Q(K3+3)
 	R8=Q(K3+3)
C POS. OF CLEF TO BE MOVED.
	K4=KPN(K2+1)
C PTR TO NEXT ITEM
	K1=K4
	K3=K3-K4
C WDCNT OF DELETE ITEM
	K4=K4-KPN(K2+2)
C NEXT +1
	K3=K3-K4
C AMOUNT OF CHANGE
C1	K5=KPN(K2+2)
C	K5=K5-KPN(K2+1)
C	K5=K5+KPN(K2)
C	KPN(K2+1)=K5
1	KPN(K2+1)=KPN(K2+2)-KPN(K2+1)+KPN(K2)

	IF(K2.EQ.L10)GO TO 4
	K2=K2+1
	GO TO 1
4	K2=KPN(K2+1)
C LAST PTR
C	A7=Q(K6+3)
	R4=Q(K6+3)
C POS FOR LATER "MOVE"
2	Q(K6)=Q(K1)
	K1=K1+1
	IF(K1.EQ.L11)GO TO 5
	K6=K6+1
	GO TO 2
5	IT=L10
	I=L10
C I=LEND (FOR FINAL ENDPOINT)
C	R4=A7
C	R8=A13
C R8=EXPAND REMAINDER OF LINE TO CLEF POS.
6	LL=0
C LL=0 (NO JUSTIFY)
	R5=200.
	R2=0
	R9=R5
	R7=0
	CALL PTMOVE(Q,KPN(K12))
	END

C	SUBROUTINE EXPND(J)
CC TO SHIFT LINE TO RT. WHEN ADDING KSIG.
C	COMMON/STF/RSTFAC(8),RSTJ2 
C	COMMON R2,JA,REST,J2,R3,R4,R5,R6,R7,R8,R9
C	COMMON /PX/KPN(1) /Q/Q(1) /LLL/LLL,LL,I
CC??	A5=5.
C	R4=7.1*RSTJ2
C	K12=J+2
CC GET PTR TO KPN   ADD 2 (FOR NOW, ANYWAY)
C	R8=0
CC  GO MOVE IT
C6	LL=0
CC LL=0 (NO JUSTIFY)
C	R5=200.
C	R2=0
C	R9=R5
C	R7=0
C	CALL PTMOVE(Q,KPN(K12))
C	END

	SUBROUTINE SLRV(KK,C)
	COMMON /Q/Q(1)
	Q(KK+4)=C+Q(KK+4)
	Q(KK+5)=C+Q(KK+5)
C ADD NUM. TO HEIGHT PARAMETERS
	Q(KK+7)=-Q(KK+7)
C  INVERT THE SLUR
	END

	FUNCTION CLEFN(Q,J)
	DIMENSION Q(1)
	CLEFN=0
	IF(Q(J).LT.3.)RETURN
	CLEFN=Q(J+5)
	END

	SUBROUTINE MMNN(K)
	COMMON /JN/J,N  /XRN/MM(500),NN(1)
	N=N+1
	IF(K.NE.3)NN(N)=-1
C   FOR SECONDARY POSITIONS.
	MM(N)=J+K
	END

	FUNCTION CODEN(K,N,R,M)
	DIMENSION K(1),R(1)
	M=K(N)
	CODEN=R(M+1)
C  GET THE CODE NUMBER AND SAVE THE POINTER IN M.
	END
	
	FUNCTION ZERO(X,Y)
	ZERO=X-Y
CC	IF(ABS(ZERO).LE..01)ZERO=0
	IF(ZERO.LT.0)ZERO=-ZERO
	IF(ZERO.LE..01)ZERO=0
	END

C DO NEXT IF MORE THAN 1 STAFF(KPG) AND DIFF. SIZE FACTORS ARE FOUND.
	SUBROUTINE  BARFAC(KPG,BFAC,JK)
	COMMON /STF/RSTFAC(8)  /XRN/RN(1) /PX/KPN(1) /Q/Q(1) /JN/J
	  R=RSTFAC(1)
	DO 5112 K=2,KPG
5112	   IF(R.NE.RSTFAC(K))GO TO 6112
	RETURN
C NEXT TO FIND PROBABLE SIZE FACTOR FOR THIS BAR. (NOT FOR PARTS)
C  FIND LINE WITH MOST ACTIVITY.
C  ALL THIS SORT OF WORKS.  SOMEDAY REVIEW IT.********
6112	   DO 1112 K=1,8
1112	   RN(K)=0
	DO 112 K=JK,J-1
	JD=KPN(K)
	R=Q(JD+1)
	IF(R.GT.3.)GO TO 112
	A=1.0
C  CHECKS FOR NUMBER OF NOTES, RESTS, CLEFS.
	IF(R.EQ.2)A=0.6
C SKIP NON-RHYTHM CHORD NOTES.   RESTS ARE CONSIDERED LESS IMPORTANT.
	 IF(R.NE.1)GO TO 4112
	IF(Q(JD).LT.7)GO TO 112
	IF(Q(JD+9).LE.0)GO TO 112
4112	   LF=Q(JD+2)+1
	RN(LF)=RN(LF)+A 
112	   CONTINUE
	JD=1
	B=RN(1)*RSTFAC(1)
	DO 2112 K=2,KPG
	A=RN(K)*RSTFAC(K)
	IF(A.LE.B)GO TO 2112
	JD=K
	B=A
2112	   CONTINUE
	BFAC=BFAC*(RSTFAC(JD)+.1)
C  +.1 ABOVE TO MINIMIZE DIFF. IN SIZE FACTOR.
	END